home *** CD-ROM | disk | FTP | other *** search
/ Aminet 23 / Aminet 23 (1998)(GTI - Schatztruhe)[!][Feb 1998].iso / Aminet / dev / lang / nrcobol_1b.lha / NRCOBOL1b / COBFILES / DATA.COB < prev    next >
Text File  |  1997-06-25  |  3KB  |  93 lines
  1.        IDENTIFICATION DIVISION.
  2.        PROGRAM-ID.  DATA.
  3.       *
  4.        ENVIRONMENT DIVISION.
  5.        CONFIGURATION SECTION.
  6.        SOURCE-COMPUTER.
  7.        OBJECT-COMPUTER.
  8.        INPUT-OUTPUT SECTION.
  9.        FILE-CONTROL.
  10.            SELECT STUDENT-FILE ASSIGN TO DISK
  11.            ORGANIZATION IS SEQUENTIAL
  12.            ACCESS MODE IS SEQUENTIAL
  13.            FILE STATUS IS WS-FILE-STATUS.
  14.       *
  15.        DATA DIVISION.
  16.        FILE SECTION.
  17.        FD STUDENT-FILE
  18.            LABEL RECORDS STANDARD
  19.            VALUE OF FILE-ID IS "STUDENT.FIL".
  20.        01  OUT-STUDENT-REC.
  21.            03  ER-STUDENT-NUMBER        PIC 9(4).
  22.            03  ER-STUDENT-NAME          PIC X(20).
  23.            03  ER-ENROLLED-CREDITS      PIC 9(2).
  24.       *
  25.       *
  26.        WORKING-STORAGE SECTION.
  27.      
  28.        01 WS-STUDENT-REC.
  29.            03 WS-STUDENT-NUMBER      PIC 9(4).
  30.            03 WS-STUDENT-NAME        PIC X(20).
  31.            03 WS-ENROLLED-CREDITS    PIC 9(2).
  32.        01 WS-STOP-FLAG               PIC X   VALUE " ".
  33.        01 WS-RESPONCE                PIC X.
  34.            88 WS-RESPONCE-Q                  VALUE "Q" "q".
  35.        01 WS-FILE-STATUS             PIC XX  VALUE "00".    
  36.       *
  37.        SCREEN SECTION.
  38.        01 ENTRY-SCREEN.
  39.            03 BLANK SCREEN.
  40.            03 LINE 1 COLUMN 15 VALUE 
  41.                               "ENTER STUDENT DETAILS AS DIRECTED".
  42.        01 BLANK-LINE.
  43.            03 BLANK LINE.
  44.        01 ERROR-MESSG.
  45.            03 LINE 24 COLUMN 8   
  46.               VALUE "FILE WOULD NOT OPEN CODE RETURNED : ".
  47.            03 LINE 24 COLUMN 44   HIGHLIGHT PIC XX
  48.               FROM  WS-FILE-STATUS.
  49.        PROCEDURE DIVISION.
  50.       *
  51.        000-MAIN.
  52.            OPEN OUTPUT STUDENT-FILE.
  53.            IF WS-FILE-STATUS  EQUAL "00"
  54.                      PERFORM 100-MAIN UNTIL WS-STOP-FLAG = "S"
  55.               ELSE
  56.                      DISPLAY ERROR-MESSG.
  57.            CLOSE STUDENT-FILE.
  58.            STOP RUN.
  59.       *********************************************************
  60.       *
  61.        100-MAIN.
  62.            DISPLAY ENTRY-SCREEN.
  63.            DISPLAY (23, 8) "PRESS Q TO QUIT."
  64.            ACCEPT (23, 25)  WS-RESPONCE.
  65.            IF NOT WS-RESPONCE-Q
  66.               PERFORM 200-DATA-ENTRY
  67.            ELSE
  68.               MOVE "S" TO WS-STOP-FLAG.
  69.       *
  70.       ************************************************************
  71.        200-DATA-ENTRY.
  72.            DISPLAY ENTRY-SCREEN.
  73.            DISPLAY (6, 8) 
  74.                    "ENTER STUDENT NUMBER,MAXIMUM NUMBER 4     : ".
  75.            MOVE ZERO TO WS-STUDENT-NUMBER.
  76.            ACCEPT  (6, 52) WS-STUDENT-NUMBER.
  77.  
  78.            DISPLAY (8, 8) 
  79.                    "ENTER STUDENT NAME ,MAXIMUM 20 CHARECTERS : ".
  80.            MOVE SPACES TO WS-STUDENT-NAME.
  81.            ACCEPT  (8, 52) WS-STUDENT-NAME.
  82.  
  83.            DISPLAY (10, 8) 
  84.                    "ENTER STUDENT ENROLLED CREDITS , MAX 2   : ".
  85.            MOVE ZEROS TO WS-ENROLLED-CREDITS.
  86.            ACCEPT  (10, 52) WS-ENROLLED-CREDITS.
  87.  
  88.            MOVE WS-STUDENT-REC TO OUT-STUDENT-REC.
  89.            WRITE OUT-STUDENT-REC.
  90.       *
  91.       *
  92.       ***************************************************
  93.